perm filename BASIC.LAP[206,JMC] blob sn#072125 filedate 1973-11-14 generic text, type T, neo UTF8
(DEFPROP BASICFNS (BASICFNS ORLIS ANDLIS MAPCAR2 MAPCHOOSE MAPAPP PRUP LISTSUBT LISTSUBTA CONTAINED DELETE PICKO→
UT PICKOUTA) VALUE) 

(LAP ORLIS SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (JUMPE 2 TAG2) 
       (HLRZ@ 1 2) 
       (CALLF@ 1 -1 P) 
       (JUMPN 1 TAG1) 
       (HRRZ@ 2 0 P) 
       (MOVE 1 -1 P) 
       (CALL 2 (E ORLIS) S) 
       (JUMPN 1 TAG1) 
 TAG2  (TDZA 1 1) 
 TAG1  (MOVEI 1 (QUOTE T) S) 
       (SUB P (C 2 0 2 0)) 
       (POPJ P) 
       NIL 

(LAP ANDLIS SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (JUMPE 2 TAG1) 
       (HLRZ@ 1 2) 
       (CALLF@ 1 -1 P) 
       (JUMPE 1 TAG5) 
       (HRRZ@ 2 0 P) 
       (MOVE 1 -1 P) 
       (CALL 2 (E ANDLIS) S) 
       (JUMPN 1 TAG1) 
 TAG5  (TDZA 1 1) 
 TAG1  (MOVEI 1 (QUOTE T) S) 
       (SUB P (C 2 0 2 0)) 
       (POPJ P) 
       NIL 

(LAP MAPCAR2 SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (PUSH P 3) 
       (MOVE 1 2) 
       (JUMPE 1 TAG1) 
       (HLRZ@ 2 0 P) 
       (HLRZ@ 1 -1 P) 
       (CALLF@ 2 -2 P) 
       (HRRZ@ 3 0 P) 
       (HRRZ@ 2 -1 P) 
       (PUSH P 1) 
       (MOVE 1 -3 P) 
       (CALL 3 (E MAPCAR2) S) 
       (POP P 2) 
       (CALL 2 (E XCONS) S) 
 TAG1  (SUB P (C 3 0 3 0)) 
       (POPJ P) 
       NIL 

(LAP MAPCHOOSE SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (PUSH P 3) 
       (MOVE 1 3) 
       (JUMPE 1 TAG1) 
       (HLRZ@ 1 1) 
       (CALLF@ 1 -2 P) 
       (JUMPE 1 TAG2) 
       (HLRZ@ 1 0 P) 
       (CALLF@ 1 -1 P) 
       (HRRZ@ 3 0 P) 
       (MOVE 2 -1 P) 
       (PUSH P 1) 
       (MOVE 1 -3 P) 
       (CALL 3 (E MAPCHOOSE) S) 
       (POP P 2) 
       (CALL 2 (E XCONS) S) 
       (JRST 0 TAG1) 
 TAG2  (HRRZ@ 3 0 P) 
       (MOVE 2 -1 P) 
       (MOVE 1 -2 P) 
       (CALL 3 (E MAPCHOOSE) S) 
 TAG1  (SUB P (C 3 0 3 0)) 
       (POPJ P) 
       NIL 

(LAP MAPAPP SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (MOVE 1 2) 
       (JUMPE 1 TAG1) 
       (HLRZ@ 1 0 P) 
       (CALLF@ 1 -1 P) 
       (HRRZ@ 2 0 P) 
       (PUSH P 1) 
       (MOVE 1 -2 P) 
       (CALL 2 (E MAPAPP) S) 
       (MOVE 2 1) 
       (POP P 1) 
       (CALL 2 (E *APPEND) S) 
 TAG1  (SUB P (C 2 0 2 0)) 
       (POPJ P) 
       NIL 

(LAP PRUP SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (JUMPN 1 TAG2) 
       (MOVE 1 2) 
       (JUMPE 1 TAG4) 
       (MOVEI 1 (QUOTE (V LONGER - PRUP)) S) 
       (CALL 1 (E ERROR) S) 
 TAG4  (JRST 0 TAG1) 
 TAG2  (JUMPN 2 TAG7) 
       (MOVEI 1 (QUOTE (U LONGER - PRUP)) S) 
       (CALL 1 (E ERROR) S) 
       (JRST 0 TAG1) 
 TAG7  (HLRZ@ 2 0 P) 
       (HLRZ@ 1 -1 P) 
       (CALL 2 (E CONS) S) 
       (HRRZ@ 2 0 P) 
       (PUSH P 1) 
       (HRRZ@ 1 -2 P) 
       (CALL 2 (E PRUP) S) 
       (POP P 2) 
       (CALL 2 (E XCONS) S) 
 TAG1  (SUB P (C 2 0 2 0)) 
       (POPJ P) 
       NIL 

(LAP LISTSUBT SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (CALL 1 (E LENGTH) S) 
       (EXCH 1 0 P) 
       (CALL 1 (E LENGTH) S) 
       (MOVE 2 1) 
       (POP P 1) 
       (CALL 2 (E *DIF) S) 
       (MOVEI 3 (QUOTE NIL)) 
       (MOVE 2 1) 
       (POP P 1) 
       (JCALL 3 (E LISTSUBTA) S) 
       NIL 

(LAP LISTSUBTA SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (PUSH P 3) 
       (MOVEI 2 (QUOTE 0)) 
       (MOVE 1 -1 P) 
       (CALL 2 (E EQUAL) S) 
       (JUMPE 1 TAG2) 
       (MOVE 1 0 P) 
       (JRST 0 TAG1) 
 TAG2  (HRRZ@ 1 -2 P) 
       (PUSH P 1) 
       (MOVE 1 -2 P) 
       (CALL 1 (E SUB1) S) 
       (MOVE 2 -1 P) 
       (PUSH P 1) 
       (HLRZ@ 1 -4 P) 
       (CALL 2 (E CONS) S) 
       (MOVE 3 1) 
       (POP P 2) 
       (POP P 1) 
       (CALL 3 (E LISTSUBTA) S) 
 TAG1  (SUB P (C 3 0 3 0)) 
       (POPJ P) 
       NIL 

(LAP CONTAINED SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (JUMPE 1 TAG1) 
       (HLRZ@ 1 1) 
       (CALL 2 (E MEMBER) S) 
       (JUMPE 1 TAG5) 
       (MOVE 2 0 P) 
       (HRRZ@ 1 -1 P) 
       (CALL 2 (E CONTAINED) S) 
       (JUMPN 1 TAG1) 
 TAG5  (TDZA 1 1) 
 TAG1  (MOVEI 1 (QUOTE T) S) 
       (SUB P (C 2 0 2 0)) 
       (POPJ P) 
       NIL 

(LAP DELETE SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (MOVE 1 2) 
       (JUMPE 1 TAG1) 
       (HLRZ@ 2 1) 
       (MOVE 1 -1 P) 
       (CALL 2 (E EQUAL) S) 
       (JUMPE 1 TAG2) 
       (HRRZ@ 1 0 P) 
       (JRST 0 TAG1) 
 TAG2  (HLRZ@ 1 0 P) 
       (HRRZ@ 2 0 P) 
       (PUSH P 1) 
       (MOVE 1 -2 P) 
       (CALL 2 (E DELETE) S) 
       (POP P 2) 
       (CALL 2 (E XCONS) S) 
 TAG1  (SUB P (C 2 0 2 0)) 
       (POPJ P) 
       NIL 

(LAP PICKOUT SUBR) 
       (MOVEI 4 (QUOTE NIL)) 
       (MOVEI 3 (QUOTE NIL)) 
       (JCALL 4 (E PICKOUTA) S) 
       NIL 

(LAP PICKOUTA SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (PUSH P 3) 
       (PUSH P 4) 
       (JUMPN 2 TAG2) 
       (MOVE 2 4) 
       (MOVE 1 3) 
       (CALL 2 (E CONS) S) 
       (JRST 0 TAG1) 
 TAG2  (HLRZ@ 1 2) 
       (CALLF@ 1 -3 P) 
       (JUMPE 1 TAG4) 
       (MOVE 2 -1 P) 
       (HLRZ@ 1 -2 P) 
       (CALL 2 (E CONS) S) 
       (MOVE 4 0 P) 
       (MOVE 3 1) 
       (HRRZ@ 2 -2 P) 
       (MOVE 1 -3 P) 
       (CALL 4 (E PICKOUTA) S) 
       (JRST 0 TAG1) 
 TAG4  (MOVE 2 0 P) 
       (HLRZ@ 1 -2 P) 
       (CALL 2 (E CONS) S) 
       (MOVE 4 1) 
       (MOVE 3 -1 P) 
       (HRRZ@ 2 -2 P) 
       (MOVE 1 -3 P) 
       (CALL 4 (E PICKOUTA) S) 
 TAG1  (SUB P (C 4 0 4 0)) 
       (POPJ P) 
       NIL